home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / Modes / sasMode.tcl < prev    next >
Encoding:
Text File  |  2001-01-26  |  53.6 KB  |  1,653 lines
  1. ## -*-Tcl-*- (nowrap)
  2.  # ==========================================================================
  3.  #  Statistical Modes - an extension package for Alpha
  4.  # 
  5.  #  FILE: "sasMode.tcl"
  6.  #                                    created: 01/15/00 {07:15:32 pm} 
  7.  #                                last update: 01/26/01 {12:22:11 pm} 
  8.  #  Description: 
  9.  #  
  10.  #  For SAS syntax files.  SAS is not my statistical package of choice. 
  11.  #  Anyone who has access to a newer manual should feel free to update the
  12.  #  list of keywords and send them along to me.
  13.  # 
  14.  #  Author: Craig Barton Upright
  15.  #  E-mail: <cupright@princeton.edu>
  16.  #    mail: Princeton University,  Department of Sociology
  17.  #          Princeton, New Jersey  08544
  18.  #     www: <http://www.princeton.edu/~cupright>
  19.  #  
  20.  # -------------------------------------------------------------------
  21.  #  
  22.  # Copyright (c) 2000-2001  Craig Barton Upright
  23.  # 
  24.  # This program is free software; you can redistribute it and/or modify
  25.  # it under the terms of the GNU General Public License as published by
  26.  # the Free Software Foundation; either version 2 of the License, or
  27.  # (at your option) any later version.
  28.  # 
  29.  # This program is distributed in the hope that it will be useful,
  30.  # but WITHOUT ANY WARRANTY; without even the implied warranty of
  31.  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  32.  # GNU General Public License for more details.
  33.  # 
  34.  # You should have received a copy of the GNU General Public License
  35.  # along with this program; if not, write to the Free Software
  36.  # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  37.  # 
  38.  # ==========================================================================
  39.  ##
  40.  
  41. # ===========================================================================
  42. #
  43. # ◊◊◊◊ Initialization of SAS mode ◊◊◊◊ #
  44. # 
  45.  
  46. alpha::mode SAS 2.1.1 sasMenu {*.sas} {
  47.     sasMenu electricReturn electricTab electricSemicolon electricBraces
  48. } {
  49.     # We require 7.4b21 for prefs handling.
  50.     alpha::package require -loose AlphaTcl 7.4b21
  51.     addMenu sasMenu "SAS" SAS
  52.     set unixMode(sas) {SAS}
  53.     set modeCreator(SaS6) {SAS}
  54. } uninstall {
  55.     this-file
  56. } help {
  57.     file "Statistical Modes Help"
  58. } maintainer {
  59.     "Craig Barton Upright" <cupright@princeton.edu> 
  60.     <http://www.princeton.edu/~cupright/>
  61. }
  62.  
  63. hook::register quitHook SAS::quitHook
  64.  
  65. proc sasMenu {} {}
  66.  
  67. proc sasMode.tcl {} {}
  68.  
  69. namespace eval SAS {}
  70.  
  71. # ===========================================================================
  72. #
  73. # ◊◊◊◊ Setting SAS mode variables ◊◊◊◊ #
  74. #
  75.  
  76. # Removing obsolete preferences from earlier versions.
  77.  
  78. set oldvars {
  79.     addOptions addParameters addProcs addSubProcs autoMark don'tRemindMe
  80.     electricTab funcExpr functionColor indentSlashEndLines keywordColor
  81.     parseExpr procColor subprocColor sasHelp
  82. }
  83.  
  84. foreach oldvar $oldvars {prefs::removeObsolete SASmodeVars($oldvar)}
  85.  
  86. unset oldvar oldvars
  87.  
  88. # ===========================================================================
  89. #
  90. # Standard preferences recognized by various Alpha procs
  91. #
  92.  
  93.  
  94. newPref var  fillColumn         {75}            SAS
  95. newPref var  leftFillColumn     {0}             SAS
  96. newPref var  prefixString       {* }            SAS
  97. newPref var  wordBreak          {[a-zA-Z0-9]+}  SAS
  98. newPref var  wordBreakPreface   {[^-a-zA-Z0-9]} SAS
  99. newPref flag wordWrap           {0}             SAS
  100.  
  101. # ===========================================================================
  102. #
  103. # Flag preferences
  104. #
  105.  
  106. newPref flag autoMark           {0}     SAS     {SAS::rebuildMenu markSasFileAs}
  107.  
  108. # Indent all continued commands, indicated by the lack of a semi-colon at
  109. # the end of a line, by the full indentation amount rather than half.
  110. newPref flag fullIndent         {1}     SAS     {SAS::rebuildMenu markSasFileAs}
  111.  
  112. # By default command double-click will send a command to on-line help, and
  113. # option double-click sends a command to the local SAS application. 
  114. # Check this box to switch these key combinations.
  115. newPref flag localHelp          {0}     SAS     {SAS::rebuildMenu sasHelp}
  116.  
  117. # Check this box if your keyboard does not have a "Help" key.  This will
  118. # change some of the menu's key bindings.
  119. newPref flag noHelpKey          {0}     SAS     {SAS::rebuildMenu sasHelp}
  120.  
  121. # Set the list of flag preferences which can be changed in the menu.
  122.  
  123. set SASPrefsInMenu [list        \
  124.   "localHelp"                   \
  125.   "noHelpKey"                   \
  126.   "fullIndent"                  \
  127.   ]
  128.  
  129. # ===========================================================================
  130. #
  131. # Variable preferences
  132. # 
  133.  
  134. # Enter additional arguments to be colorized. 
  135. newPref var addArguments        {}      SAS     {SAS::colorizeSAS}
  136.  
  137. # Enter additional SAS proc commands to be colorized.  
  138. newPref var addCommands         {}      SAS     {SAS::colorizeSAS}
  139.  
  140. # Command double-clicking on a SAS keyword will send it to this url for a
  141. # help reference page.
  142. newPref url helpUrl             {}      SAS
  143.  
  144. # The "SAS Home Page" menu item will send this url to your browser.
  145. newPref url sasHomePage         {http://www.sas.com/}   SAS
  146.  
  147. # Click on "Set" to find the local SAS application.
  148. newPref sig sasSig              {SaS6}  SAS
  149.  
  150. # ===========================================================================
  151. #
  152. # Color preferences
  153. #
  154. # Nomenclature notes:
  155. # 
  156. # SAS seems to have five levels of possible keywords.
  157. # 
  158. #   1. the top level "proc" specification:  anova, freq varcomp
  159. #   2. sub-level procs (or "subprocs"):  rename, value, range
  160. #   2. "arguments", which require no parameters:  ls, missover, in1
  161. #   3. "options", which require parameters:  converge, data, gamma
  162. #   4. "parameters", preset as opposed to user supplied: full, part  
  163. #
  164. # The default setup of this mode is to colorize all of procs and subprocs
  165. # blue; arguments, options, and parameters are magenta.  The user does not
  166. # have to specify all of these different levels -- only Argument, Command,
  167. # Comment, String, and Symbol colors appear in the preferences.
  168. # 
  169. # Of these four statistical packages, I am the most unfamiliar with SAS.
  170. # This mode is my good-hearted attempt, but is distributed with no
  171. # assurances that it is complete.
  172. # 
  173.  
  174. # See the Statistical Modes Help file for an explanation of these different
  175. # categories, and lists of keywords.
  176. newPref color argumentColor     {magenta}   SAS     {SAS::colorizeSAS}
  177. newPref color commandColor      {blue}      SAS     {SAS::colorizeSAS}
  178. newPref color commentColor      {red}       SAS     {stringColorProc}
  179. newPref color stringColor       {green}     SAS     {stringColorProc}
  180.  
  181. # The color of symbols such as "/", "@", etc.
  182. newPref color symbolColor       {magenta}   SAS     {SAS::colorizeSAS}
  183.  
  184. regModeKeywords -e {*} -b {/*} {*/}     \
  185.   -c $SASmodeVars(commentColor)         \
  186.   -s $SASmodeVars(stringColor) SAS {} 
  187.  
  188. # ===========================================================================
  189. # 
  190. # Flag Flip
  191. #
  192. # Called by menu items, change the value of flag preferences.
  193. # 
  194.  
  195. proc SAS::flagFlip {pref} {
  196.  
  197.     global mode SASmodeVars
  198.  
  199.     set SASmodeVars($pref) [expr {$SASmodeVars($pref) ? 0 : 1}]
  200.     set oldMode $mode
  201.     set mode "SAS"
  202.     synchroniseModeVar $pref $SASmodeVars($pref)
  203.     set mode $oldMode
  204.     if {$SASmodeVars($pref)} {
  205.         set end "on"
  206.     } else {
  207.         set end "off"
  208.     }
  209.     message "The \"$pref\" preference is now $end."
  210. }
  211.  
  212. # ===========================================================================
  213. # 
  214. # Comment Character variables for Comment Line / Paragraph / Box menu items.
  215. # 
  216.  
  217. set SAS::commentCharacters(General)     "* "
  218. set SAS::commentCharacters(Paragraph)   [list "/* " " */" " * "]
  219. set SAS::commentCharacters(Box)         [list "/*" 2 "*/" 2 "*" 3]
  220.  
  221. # The Comment Line command is hard-wired -- except for the C and C++ modes,
  222. # if the commentCharacters(Paragraph) are different, then Comment Line will
  223. # automatically be bracketed.  Thus I am simply redefining the command-d
  224. # key-binding to ignore commentLine
  225.  
  226. Bind 'd' <c>  {insertPrefix} SAS
  227.  
  228. # ===========================================================================
  229. #
  230. # ◊◊◊◊ Keyword Dictionaries ◊◊◊◊ #
  231. #
  232.  
  233. # Making sure that SASUserCommands and SASUserArguments exist.
  234. # These will be over-ridden if they are loaded from a ${mode}Prefs.tcl file.
  235. #
  236.  
  237. set SASUserCommands     ""
  238. set SASUserArguments    ""
  239.  
  240. # ===========================================================================
  241. #
  242. # ◊◊◊◊   SAS Commands   ◊◊◊◊ #
  243. #
  244.  
  245. set SASCommands {
  246.     aceclus anova calis cancorr candisc catmod cluster corresp discrim
  247.     factor fastclus format freq genmod glm glmmod inbreed kde krige2d
  248.     lattice lifereg lifetest loess logistic mds mixed modeclus multtest
  249.     nested nlin nlmixed npar1way orthoreg phreg plan pls princomp prinqual
  250.     probit proc reg rsreg score stepdisc surveymeans surveyreg surveyselect
  251.     tpspline transreg tree ttest varclus varcomp variogram
  252. }
  253.  
  254. # ===========================================================================
  255. #
  256. # ◊◊◊◊   SAS Subprocs   ◊◊◊◊ #
  257. #
  258.  
  259. set SASSubprocs {
  260.     arima array autoreg average axis1 axis2 by cards centroid choro "class"
  261.     col colblock colcopy collist colpct cols column columns complete
  262.     computab contents control data datasource density dftest do end
  263.     endogenous estimate exogenous filename fit footnote1 footnote2
  264.     footnote3 footnote4 forecast form gmap goptions gplot id identify
  265.     infile input instruments keep label lagged last legend legend1 legend2
  266.     length let libname macro merge model monthly options output parms
  267.     pattern1 pattern2 pattern3 pattern4 pattern5 pattern6 pattern7 pattern8
  268.     plot print put quarterly quit range rename restrict retain return row
  269.     rowblock rowcopy rowlist rows run select set solve sort sumby symbol
  270.     symbol1 symbol2 symbol3 symbol3 symbol4 tables threshold title title1
  271.     title2 title3 title4 value var weights where
  272. }
  273.  
  274. # ===========================================================================
  275. #
  276. # ◊◊◊◊   SAS Arguments   ◊◊◊◊ #
  277. #
  278.  
  279. set SASArguments {
  280.     _col_ _row_ all b bcorr bcov bsscp bvreg c cback clogit clogits colors
  281.     corr corrb dbname device distance eof f garch gr2 h haxis hpos href i
  282.     in1 int intercept interval j joint l lead logit logits lrecl ls lsd
  283.     lspace map marginal marginals maxit maxiter mean means method
  284.     "missover" mpsprt mySAS nodesign nogls noint noiter noparm noprint
  285.     noprofile noresponse notrans noun obs oneway outall outby outcont
  286.     outest pcorr pcov pp printout proby psscp qq red redundancy regwf regwq
  287.     response s scjeffe seb short short shortanova sidak simple smc smm snk
  288.     spcorr sqpcorr sqspcorr stb stdmean survey t tcorr tcov trend tsscp
  289.     tukey type v vdep vpos w waller wcorr wcov wdep wsscp wteg
  290. }
  291.  
  292. # ===========================================================================
  293. #
  294. # ◊◊◊◊   SAS Options   ◊◊◊◊ #
  295. #
  296.  
  297. set SASOptions {
  298.     absolute absorb archtest border converge crosscorr diagonal dif dwprob
  299.     filetype frame from identity initial intnx log manova maxiter metric
  300.     mulripass nlag nlags noconstant noobs noprint ourstat out outfull
  301.     outselect outstat overlay partial prefix rannor sing singular to weight
  302.     xlog
  303. }
  304.     
  305.  
  306. # ===========================================================================
  307. #
  308. # ◊◊◊◊   SAS Parameters   ◊◊◊◊ #
  309. #
  310.  
  311. set SASParameters {
  312.     absolute absorb and asmc average biweight centroid circle complete
  313.     converge density diagonal else eml epanechnikov equamax flexible
  314.     formatted full identity if if in initial internal join kj manova max
  315.     maxiter mcquitty median metric multipass needle no none normal npar one
  316.     orthmox ourstat out outstat p percent plus prefix procustes promax
  317.     proportion qtrvars quarimax random sing single singular smc sorted
  318.     special spline splines star test then triweight twostage uniform
  319.     varimax ward weight yes
  320. }
  321.  
  322. # ===========================================================================
  323. # 
  324. # Colorize SAS.
  325. # 
  326. # Set all keyword lists, and colorize.
  327. # 
  328. # Could also be called in a <mode>Prefs.tcl file
  329. # 
  330.  
  331. proc SAS::colorizeSAS {{pref ""}} {
  332.     
  333.     global SASmodeVars SASCommands   SASSubprocs     SASArguments 
  334.     global SASOptions  SASParameters SASUserCommands SASUserArguments
  335.     
  336.     global SASlowerCaseCmds SASbothCaseCommands SASArgumentsList SAScmds
  337.     
  338.     # Procs and Subprocs only, for SAS::Completion::Command.
  339.     set SASlowerCaseCommands [concat \
  340.       $SASCommands $SASSubprocs $SASmodeVars(addCommands) $SASUserCommands]
  341.     message "Creating ALL CAP commands for SAS mode …"
  342.     set SASupperCaseCommands [string toupper $SASlowerCaseCommands]
  343.  
  344.     set SASbothCaseCommands [lsort [concat \
  345.       $SASlowerCaseCommands $SASupperCaseCommands]]
  346.     # Arguments, Options, Parameters
  347.     set SASArgumentsList [concat \
  348.       $SASArguments  $SASmodeVars(addArguments) $SASOptions \
  349.       $SASParameters $SASUserArguments]
  350.     
  351.     # Then, create the list of all keywords for completions.  SAS
  352.     # keywords are not case-sensitive.  To allow for different user
  353.     # styles, we'll include lower case commands as well as ALL CAPS.
  354.     set SASlowerCaseCmds [concat \
  355.       $SASlowerCaseCommands $SASArgumentsList]
  356.     
  357.     set SASupperCaseCmds [string toupper $SASlowerCaseCmds]
  358.  
  359.     set SAScmds [lsort [lunique [concat \
  360.       $SASlowerCaseCmds $SASupperCaseCmds]]]
  361.     message ""
  362.     
  363.     # Commands
  364.     regModeKeywords -a                                              \
  365.       -k $SASmodeVars(commandColor) SAS $SASbothCaseCommands 
  366.     
  367.     # Arguments, Options, Parameters
  368.     regModeKeywords -a                                              \
  369.       -k $SASmodeVars(argumentColor) SAS $SASArgumentsList
  370.     
  371.     # Symbols
  372.     regModeKeywords -a                                              \
  373.       -k $SASmodeVars(symbolColor) SAS {|}                          \
  374.       -i "+" -i "-" -i "_" -i "\\"                                  \
  375.       -I $SASmodeVars(symbolColor)
  376.  
  377.     if {$pref != ""} {refresh}
  378. }
  379.  
  380. # Call this now.
  381.  
  382. SAS::colorizeSAS
  383.  
  384. # ===========================================================================
  385. #
  386. # Reload Completions.
  387. # 
  388. # 
  389. # This is now an obsolete proc.
  390. # 
  391.  
  392. proc SAS::reloadCompletions {} {
  393.     alertnote "\"SAS::reloadCompletions\" is an obsolete proc.\
  394.       It should be removed from your SASPrefs.tcl file."
  395. }
  396.  
  397. # ===========================================================================
  398. #
  399. # ◊◊◊◊ Key Bindings, Electrics ◊◊◊◊ #
  400. # 
  401. # abbreviations:  <o> = option, <z> = control, <s> = shift, <c> = command
  402. # 
  403.  
  404. # Known bug: Key-bindings from other global menus might conflict with those
  405. # defined in the SAS menu.  This will help ensure that this doesn't happen.
  406.  
  407. Bind 's'    <cs>    {SAS::switchToSas} SAS
  408. Bind 'p'    <cs>    {SAS::processFile} SAS
  409. Bind 'p'    <csz>   {SAS::processSelection} SAS
  410. Bind 'p'    <cs>    {SAS::insertPath} SAS
  411.  
  412. Bind 'n'    <sz>    {SAS::nextCommand} SAS
  413. Bind 'p'    <sz>    {SAS::prevCommand} SAS
  414. Bind 's'    <sz>    {SAS::selectCommand} SAS
  415. Bind 'c'    <sz>    {SAS::copyCommand} SAS
  416.  
  417. Bind 'i'    <cz>    {SAS::reformatCommand} SAS
  418.  
  419. Bind '\)'           {SAS::electricRight "\)"} SAS
  420.  
  421. # For those that would rather use arrow keys to navigate.  Up and down
  422. # arrow keys will advance to next/prev command, right and left will also
  423. # set the cursor to the top of the window.
  424.  
  425. Bind    up  <sz>    {SAS::prevCommand 0 0} SAS
  426. Bind  left  <sz>    {SAS::prevCommand 0 1} SAS
  427. Bind  down  <sz>    {SAS::nextCommand 0 0} SAS
  428. Bind right  <sz>    {SAS::nextCommand 0 1} SAS
  429.  
  430. # ===========================================================================
  431. # 
  432. # SAS Electric Semi
  433. # 
  434. # Inserts a semi, carriage return, and indents properly.
  435. # 
  436.  
  437. proc SAS::electricSemi {} {
  438.     
  439.     if {[literalChar]} {
  440.         typeText {;}
  441.     } else {
  442.         typeText {;}
  443.         bind::CarriageReturn
  444.     }
  445. }
  446.  
  447. # ===========================================================================
  448. # 
  449. # SAS Carriage Return
  450. # 
  451. # Inserts a carriage return, and indents properly.
  452. # 
  453.  
  454. proc SAS::carriageReturn {} {
  455.     
  456.     global SASmodeVars
  457.     
  458.     if {[isSelection]} {
  459.         deleteSelection
  460.     } 
  461.     set pos1 [lineStart [getPos]]
  462.     set pos2 [getPos]
  463.     if {[regexp {^([\t ])*(\}|\))} [getText $pos1 $pos2]]} {
  464.         createTMark temp $pos2
  465.         catch {bind::IndentLine}
  466.         gotoTMark temp ; removeTMark temp
  467.     } 
  468.     insertText "\r"
  469.     catch {bind::IndentLine}
  470. }
  471.  
  472. # ===========================================================================
  473. #
  474. # SAS Electric Left, Right
  475. # 
  476. # Adapted from "tclMode.tcl"
  477. # 
  478.  
  479. proc SAS::electricLeft {} {
  480.  
  481.     if {[literalChar]} {
  482.         typeText "\{"
  483.         return
  484.     }
  485.     set pat "\}\[ \t\r\n\]*(else(if)?)\[ \t\r\n\]*\$"
  486.     set pos [getPos]
  487.     if { [set result [findPatJustBefore "\}" $pat $pos word]] == "" } { 
  488.         insertText "\{"
  489.         return
  490.     }
  491.     # we have an if/else(if)/else
  492.     switch -- $word {
  493.         "else" {
  494.             deleteText [lindex $result 0] $pos
  495.             elec::Insertion "\} $word \{\r\t••\r\}\r••"
  496.         }
  497.         "elseif" {
  498.             deleteText [lindex $result 0] $pos
  499.             elec::Insertion "\} $word \{••\} \{\r\t••\r\}\r••"
  500.         }
  501.     }
  502. }
  503.  
  504. proc SAS::electricRight {{char "\}"}} {
  505.     
  506.     if {[literalChar]} {
  507.         typeText $char
  508.         return
  509.     }
  510.     set pos [getPos]
  511.     typeText $char
  512.     if {![regexp {[^ \t]} [getText [lineStart $pos] $pos]]} {
  513.         set pos [lineStart $pos]
  514.         createTMark temp [getPos]
  515.         catch {bind::IndentLine}
  516.         gotoTMark temp ; removeTMark temp
  517.         bind::CarriageReturn
  518.     } 
  519.     if {[catch {blink [matchIt $char [pos::math $pos - 1]]}]} {
  520.         beep ; message "No matching $char !!"
  521.     } 
  522. }
  523.  
  524. # ===========================================================================
  525. #
  526. # ◊◊◊◊ Indentation ◊◊◊◊ #
  527. # 
  528. # SAS::correctIndentation is necessary for Smart Paste, and returns the
  529. # correct level of indentation for the current line.  SAS::indentLine uses
  530. # this level to indent the current line.
  531. # 
  532. # We have two level of indentation in SAS, for the continuation of
  533. # commands, in which case we simply indent to the amount of the SAS mode
  534. # variable indentationAmount, and for nexted braces.
  535. # 
  536. # In SAS::correctIndentation, we grab the previous non-commented line,
  537. # remove all of the characters besides braces and quotes, and then convert
  538. # it all to a list to be evaluated.  Braces contained within quotes, as
  539. # well as literal characters, should all be ignored and the remaining
  540. # braces are used to determine the correct level of nesting.
  541. # 
  542.  
  543. proc SAS::indentLine {{pos ""}} {
  544.     
  545.     if {$pos == ""} {set pos [getPos]} 
  546.     # Get details of current line.
  547.     set posBeg [lineStart [getPos]]
  548.     set text [getText $posBeg [nextLineStart $posBeg]]
  549.     regexp {^[ \t]*} $text white 
  550.     set posNext1 [pos::math $posBeg + [string length $white]]
  551.     set posNext2 [pos::math $posNext1 + 1]
  552.     if {[pos::compare $posNext2 > [maxPos]]} {
  553.         set posNext2 [maxPos]
  554.     } 
  555.     # Determine the correct level of indentation for this line, given the
  556.     # next character.
  557.     set lwhite [SAS::correctIndentation $pos [getText $posNext1 $posNext2]]
  558.     set lwhite [text::indentOf $lwhite]
  559.     if {$white != $lwhite} {
  560.         replaceText $posBeg $posNext1 $lwhite
  561.     }
  562.     goto [pos::math $posBeg + [string length $lwhite]]
  563. }
  564.  
  565. proc SAS::correctIndentation {pos {next ""}} {
  566.     
  567.     global mode indent_amounts SASmodeVars
  568.     
  569.     if {$mode == "SAS"} {
  570.         set continueIndent [expr {$SASmodeVars(fullIndent) + 1}]
  571.     } else {
  572.         set continueIndent 2
  573.     } 
  574.     
  575.     set posBeg   [lineStart $pos]
  576.     # Get information about this line, previous line ...
  577.     set thisLine  [SAS::getCommandLine $posBeg 1 1]
  578.     set prevLine1 [SAS::getCommandLine [pos::math $posBeg - 1] 0 1]
  579.     set prevLine2 [SAS::getCommandLine [pos::math [lindex $prevLine1 0] - 1] 0 1]
  580.     set lwhite    [lindex $prevLine1 1]
  581.     # If we have a previous line ...
  582.     if {[pos::compare [lindex $prevLine1 0] != $posBeg]} {
  583.         set pL1 [string trim [lindex $prevLine1 2]]
  584.         # Indent if the last line did not terminate the command.
  585.         if {![regexp {;([\t ]?)$} $pL1]} {
  586.             incr lwhite $indent_amounts($continueIndent)
  587.         } 
  588.         # Check to make sure that the previous command was not itself a
  589.         # continuation of the line before it.
  590.         if {[pos::compare [lindex $prevLine1 0] != [lindex $prevLine2 0]]} {
  591.             set pL2 [string trim [lindex $prevLine2 2]]
  592.             if {![regexp {;([\t ]?)$} $pL2]} {
  593.                 incr lwhite $indent_amounts(-$continueIndent)
  594.             } 
  595.         }
  596.         # Find out if there are any unbalanced {,},(,) in the last line.
  597.         regsub -all {[^ \{\}\(\)\"\*\/\\]} $pL1 { } line
  598.         # Remove all literals.
  599.         regsub -all {\\\{|\\\}|\\\(|\\\)|\\\"|\\\*|\\\/} $line { } line
  600.         regsub -all {\\} $line { } line
  601.         # Remove everything surrounded by quotes.
  602.         regsub -all {\"([^\"]+)\"} $line { } line
  603.         regsub -all {\"} $line { } line
  604.         # Remove everything surrounded by bracketed comments.
  605.         regsub -all {/\*([^\*/]+)\*/} $line { } line
  606.         # Now turn all braces into 2's and -2's
  607.         regsub -all {\{|\(} $line { 2 }  line
  608.         regsub -all {\}|\)} $line { -2 } line
  609.         # This list should now only contain 2's and -2's.
  610.         foreach i $line {
  611.             if {$i == "2" || $i == "-2"} {incr lwhite $indent_amounts($i)} 
  612.         }
  613.         # Did the last line start with a lone \) or \} ?  If so, we want to
  614.         # keep the indent, and not make call it an unbalanced line.
  615.         if {[regexp {^[\t ]*(\}|\))} $pL1]} {
  616.             incr lwhite $indent_amounts(2)
  617.         } 
  618.     } 
  619.     # If we have a current line ...
  620.     if {[pos::compare [lindex $thisLine 0] == $posBeg]} {
  621.         # Reduce the indent if the first non-whitespace character of this
  622.         # line is ) or \}.
  623.         set tL [lindex $thisLine 2]
  624.         if {$next == "\}" || $next == ")" || [regexp {^[\t ]*(\}|\))} $tL]} {
  625.             incr lwhite $indent_amounts(-2)
  626.         } 
  627.     } 
  628.     # Now we return the level to the calling proc.
  629.     return [expr {$lwhite > 0 ? $lwhite : 0}]
  630. }
  631.  
  632. # ===========================================================================
  633. # 
  634. # Get Command Line
  635. # 
  636. # Find the next/prev command line relative to a given position, and return
  637. # the position in which it starts, its indentation, and the complete text
  638. # of the command line.  If the search for the next/prev command fails,
  639. # return an indentation level of 0.
  640. # 
  641.  
  642. proc SAS::getCommandLine {pos {direction 1} {ignoreComments 1}} {
  643.     
  644.     if {$ignoreComments} {
  645.         set pat {^[\t ]*[^\t\r\n\*/ ]}
  646.     } else {
  647.         set pat {^[\t ]*[^\t\r\n ]}
  648.     } 
  649.     set posBeg [pos::math [lineStart $pos] - 1]
  650.     if {[pos::compare $posBeg < [minPos]]} {
  651.         set posBeg [minPos]
  652.     } 
  653.     set lwhite 0
  654.     if {![catch {search -f $direction -r 1 $pat $pos} match]} {
  655.         set posBeg [lindex $match 0]
  656.         set lwhite [posX [pos::math [lindex $match 1] - 1]]
  657.     }
  658.     set posEnd [pos::math [nextLineStart $posBeg] - 1]
  659.     if {[pos::compare $posEnd > [maxPos]]} {
  660.         set posEnd [maxPos]
  661.     } 
  662.     return [list $posBeg $lwhite [getText $posBeg $posEnd]]
  663. }
  664.  
  665. # ===========================================================================
  666. # 
  667. # ◊◊◊◊ Command Double Click ◊◊◊◊ #
  668. #
  669. # Checks to see if the highlighted word appears in any keyword list, and if
  670. # so, sends the selected word to the http://search.sas.com/ help site.
  671. # 
  672. # (Default preference is not the most useful site, but the best I could find.)
  673. #
  674. # Control-Command double click will insert syntax information in status bar.
  675. # Shift-Command double click will insert commented syntax information in window.
  676. # 
  677. # (The above is not yet implemented -- need to enter all of the syntax info.)
  678. # 
  679.  
  680. proc SAS::DblClick {from to shift option control} {
  681.     
  682.     global SASmodeVars SAScmds SASSyntaxMessage
  683.         
  684.     select $from $to
  685.     set command [getSelect]
  686.     
  687.     if {[lsearch -exact $SAScmds $command] == -1} {
  688.         message "\"$command\" is not defined as a SAS system keyword."
  689.         return
  690.     }
  691.     # Defined as a keyword, determine if there's a syntax message.
  692.     # Any modifiers pressed?
  693.     if {$control} {
  694.         # CONTROL -- Just put syntax message in status bar window
  695.         if {[info exists SASSyntaxMessage($command)]} {
  696.             message $SASSyntaxMessage($command)        
  697.         } else {
  698.             message "Sorry, no syntax information available for $command"
  699.         } 
  700.     } elseif {$shift} {
  701.         # SHIFT --Just insert syntax message as commented text
  702.         if {[info exists SASSyntaxMessage($command)]} {
  703.             endOfLine
  704.             insertText "\r"
  705.             insertText "$SASSyntaxMessage($command)"
  706.             comment::Line
  707.         } else {
  708.             message "Sorry, no syntax information available for $command"
  709.         } 
  710.     } elseif {$option && !$SASmodeVars(localHelp)} {
  711.         # Now we have four possibilities, based on "option" key and the
  712.         # preference for "local Help Only".  (Local Help Only actually
  713.         # switches the "normal" behavior of options versus not.)
  714.         # 
  715.         # OPTION, local help isn't checked -- Send command to local application
  716.         SAS::localCommandHelp $command
  717.     } elseif {$option && $SASmodeVars(localHelp)} {
  718.         # OPTION, but local help is checked -- Send command for on-line help.
  719.         SAS::wwwCommandHelp $command
  720.     } elseif {$SASmodeVars(localHelp)} {
  721.         # No modifiers, local help is checked -- Send command to local app.
  722.         SAS::localCommandHelp $command
  723.     } else {
  724.         # No modifiers, no local help checked -- Send command for on-line
  725.         # help.  This is the "default" behavior.
  726.         SAS::wwwCommandHelp $command
  727.     }
  728. }
  729.  
  730. # ===========================================================================
  731. # 
  732. # WWW Command Help
  733. # 
  734. # Send command to defined url, prompting for text if necessary.
  735. # 
  736.  
  737. proc SAS::wwwCommandHelp {{command ""}} {
  738.     
  739.     global SASmodeVars
  740.     
  741.     if {$command == ""} {
  742.         set command [prompt "on-line SAS help for ... " [getSelect]] 
  743.         # set command [statusPrompt "on-line help for ... " ] 
  744.     } 
  745.     message "\"$command\" sent to $SASmodeVars(helpUrl)"
  746.     icURL $SASmodeVars(helpUrl)$command
  747. }
  748.  
  749. # ===========================================================================
  750. # 
  751. # Local Command Help
  752. # 
  753. # Send command to local application, prompting for text if necessary.
  754. # 
  755.  
  756. proc SAS::localCommandHelp {{command ""} {app "SAS"}} {
  757.     
  758.     SAS::betaMessage
  759.     
  760.     global SASmodeVars tcl_platform
  761.     
  762.     if {$command == ""} {
  763.         set command [prompt "local $app application help for ... " [getSelect]]
  764.         # set command [statusPrompt "local $app application help for ..." ]
  765.     }
  766.     set pf $tcl_platform(platform)
  767.     
  768.     # We have three possible options here, based on platform.
  769.     
  770.     if {$pf == "macintosh"} {
  771.         # Make sure that the Macintosh application for the signature exists.
  772.         if {[catch {[nameFromAppl [SAS::sig]]}]} {
  773.             SAS::selectApplication $app
  774.         } 
  775.     } elseif {$pf == "windows" || $pf == "unix"} {
  776.         # Make sure that the Windows application for the signature exists. 
  777.         # We assume that this will work for unix, too.
  778.         if {![file exists [S::sig]]} {
  779.             SAS::selectApplication $app
  780.         } 
  781.     } 
  782.     # Now we actually do something ...
  783. }
  784.  
  785.  
  786. # ===========================================================================
  787. #
  788. # ◊◊◊◊ Mark File and Parse Functions ◊◊◊◊ #
  789. #
  790.  
  791. # ===========================================================================
  792. #
  793. # SAS Mark File
  794. # 
  795. # This will return the first 35 characters from the first non-commented
  796. # word that appears in column 0.  All other output files (those not
  797. # recognized) will take into account the additional left margin elements
  798. # added by SAS.
  799. #
  800.  
  801. proc SAS::MarkFile {{type ""}} {
  802.     
  803.     removeAllMarks
  804.     
  805.     message "Marking File …"
  806.     
  807.     set pos [minPos]
  808.     set count 0
  809.     # Figure out what type of file this is -- source, or output.
  810.     # The variable "type" refers to a call from the SAS menu.
  811.     # Otherwise we try to figure out the type based on the file's suffix.
  812.     if {$type == ""} {
  813.         if {[win::CurrentTail] == "* SAS Mode Example *"} {
  814.             # Special case for Mode Examples, but only if called from
  815.             # Marks menu.  (Called from SAS menu, "type" will over-ride.
  816.             set type  ".sas"
  817.         } else {
  818.             set type [file extension [win::CurrentTail]]
  819.         }
  820.     }
  821.     # Now set the mark regexp.
  822.     if {$type == ".sas" } {
  823.         # Source file.
  824.         set markExpr {^(\*\*\*[ ]|\*\*\*\*[ ])?[a-zA-Z0-9]}
  825.     } else {
  826.         # None of the above, so assume that it's output
  827.         set markExpr {^([0-9]+((        )|(         )))+(\*\*\*[ ]|\*\*\*\*[ ])?[a-zA-Z0-9]}
  828.     }
  829.     # Mark the file
  830.     while {![catch {search -s -f 1 -r 1 -m 0 -i 1 $markExpr $pos} match]} {
  831.         incr count 
  832.         set posBeg [lindex $match 0]
  833.         set posEnd [nextLineStart $posBeg]
  834.         if {[pos::compare $posEnd > [maxPos]]} {set posEnd [maxPos]} 
  835.         set line   [string trimright [getText $posBeg $posEnd]]
  836.         # Get rid of the leading "[0-9]  " for output files
  837.         regsub {^[0-9]*[0-9]*[0-9]*[0-9]} $line {} line
  838.         # Get rid of braces.
  839.         regsub -all {\{|\[} $line {(} line
  840.         regsub -all {\}|\]} $line {)} line
  841.         set line [string trimleft  $line " "]
  842.         set line  "  $line"
  843.         if {[regsub {  \*\*\*\* } $line {* } line]} {
  844.             incr count -1
  845.         } elseif {[regsub {  \*\*\* } $line {• } line]} {
  846.             incr count -1
  847.         } 
  848.         if {[string length $line] > 35} {
  849.             set line "[string range $line 0 35] ..."
  850.         } else {
  851.             # Get rid of trailing semi-colons.
  852.             set line  [string trimright $line ";" ]
  853.         }
  854.         # If the mark starts with "run", ignore it.
  855.         if {![regexp {^  (run|RUN)} $line]} {
  856.             setNamedMark $line $posBeg $posBeg $posBeg
  857.         } 
  858.         set pos $posEnd
  859.     }
  860.     message "This file contains $count commands."
  861. }
  862.  
  863. # ===========================================================================
  864. #
  865. # SAS Parse Functions
  866. # 
  867. # This will return only the SAS command names.
  868. # 
  869.  
  870. proc SAS::parseFuncs {} {
  871.     
  872.     global sortFuncsMenu    
  873.     
  874.     set pos [minPos]
  875.     set m {}
  876.     while {[set match [search -s -f 1 -r 1 -i 0 -n {^(\w+)} $pos]] != ""} {
  877.         if {[regexp -- {^(\w+)} [eval getText $match] "" word]} {
  878.             lappend m [list $word [lindex $match 0]]
  879.         }
  880.         set pos [lindex $match 1]
  881.     }
  882.     if {$sortFuncsMenu} {
  883.         regsub -all "\[\{\}\]" [lsort -ignore $m] "" m
  884.     } else {
  885.         regsub -all "\[\{\}\]" $m "" m
  886.     }   
  887.     return  $m
  888. }
  889.  
  890. # ===========================================================================
  891. # 
  892. # ◊◊◊◊ -------------------- ◊◊◊◊ #
  893. # 
  894. # ◊◊◊◊ SAS Menu ◊◊◊◊ #
  895. # 
  896. # based upon the Stata menu, contributed by 
  897. # L. Phillip Schumm <pschumm@uchicago.edu>
  898. # 
  899.  
  900. # Tell Alpha what procedures to use to build all menus, submenus.
  901.  
  902. menu::buildProc sasMenu             SAS::buildMenu
  903. menu::buildProc sasHelp             SAS::buildHelpMenu
  904. menu::buildProc sasKeywords         SAS::buildKeywordsMenu
  905. menu::buildProc markSasFileAs…      SAS::buildMarkMenu
  906.  
  907. # First build the main SAS menu.
  908.  
  909. proc SAS::buildMenu {} {
  910.     
  911.     global sasMenu
  912.     
  913.     set menuList [list                                  \
  914.       "sasHomePage"                                     \
  915.       "/S<U<OswitchToSas"                               \
  916.       [list Menu -n sasHelp             -M SAS {}]      \
  917.       "(-"                                              \
  918.       [list Menu -n sasKeywords         -M SAS {}]      \
  919.       [list Menu -n markSasFileAs…      -M SAS {}]      \
  920.       "(-"                                              \
  921.       "/P<U<OprocessFile"                               \
  922.       "/P<U<O<BprocessSelection"                        \
  923.       "(-"                                              \
  924.       "/I<U<OinsertPath"                                \
  925.       "(-"                                              \
  926.       "/N<U<BnextCommand"                               \
  927.       "/P<U<BprevCommand"                               \
  928.       "/S<U<BselectCommand"                             \
  929.       "/I<B<OreformatCommand"                           \
  930.       ]
  931.     set submenus [list markSasFileAs… sasHelp sasKeywords]
  932.     return       [list build $menuList SAS::menuProc $submenus $sasMenu]
  933. }
  934.  
  935. # Then build the "SAS Help" submenu.
  936.  
  937. proc SAS::buildHelpMenu {} {
  938.     
  939.     global SASmodeVars SASPrefsInMenu alpha::platform
  940.     
  941.     # Determine which key should be used for "Help", with F8 as option.
  942.     
  943.     if {!$SASmodeVars(noHelpKey)} {
  944.         set key "/t"
  945.     } else {
  946.         set key "/l"
  947.     } 
  948.     
  949.     # Reverse the local, www key bindings depending on the value of the
  950.     # 'Local Help" variable.
  951.     
  952.     if {!$SASmodeVars(localHelp)} {
  953.         set menuList [list                  \
  954.           "${key}<OwwwCommandHelp…"         \
  955.           "${key}<IlocalCommandHelp…"       \
  956.           ]
  957.     } else {
  958.         set menuList [list                  \
  959.           "${key}<OlocalCommandHelp…"       \
  960.           "${key}<IwwwCommandHelp…"         \
  961.           ]
  962.     } 
  963.     lappend menuList "(-"
  964.     if {${alpha::platform} == "alpha"} {
  965.         set prefix "!√"
  966.     } else {
  967.         set prefix "!•"
  968.     } 
  969.     foreach pref $SASPrefsInMenu {
  970.         if {$SASmodeVars($pref)} {
  971.             lappend menuList "${prefix}$pref"
  972.         } else {
  973.             lappend menuList "$pref"
  974.         }
  975.     }
  976.     lappend menuList "(-"
  977.     lappend menuList "checkKeywords"
  978.     lappend menuList "addNewCommands"
  979.     lappend menuList "addNewArguments"
  980.     lappend menuList "setSasApplication"
  981.     lappend menuList "(-"
  982.     lappend menuList "${key}<BsasModeHelp"
  983.     
  984.     return [list build $menuList SAS::helpProc {}]
  985. }
  986.  
  987. # Then build the "SAS Mode Keywords" submenu.
  988.  
  989. proc SAS::buildKeywordsMenu {} {
  990.     
  991.     set menuList [list                  \
  992.       "listKeywords"                    \
  993.       "checkKeywords"                   \
  994.       "addNewCommands"                  \
  995.       "addNewArguments"                 \
  996.       ]
  997.     return [list build $menuList SAS::keywordsProc {}]
  998. }
  999.  
  1000. # Then build the "Mark SAS File As" submenu.
  1001.  
  1002. proc SAS::buildMarkMenu {} {
  1003.     
  1004.     global SASmodeVars alpha::platform
  1005.     
  1006.     set menuList [list                  \
  1007.       "source"                          \
  1008.       "output"                          \
  1009.       "(-"                              \
  1010.       ]
  1011.     if {${alpha::platform} == "alpha"} {
  1012.         set prefix "!√"
  1013.     } else {
  1014.         set prefix "!•"
  1015.     } 
  1016.     if {$SASmodeVars(autoMark)} {
  1017.         lappend menuList "${prefix}autoMark"
  1018.     } else {
  1019.         lappend menuList "autoMark"
  1020.     }
  1021.     return [list build $menuList SAS::markFileProc {}]
  1022. }
  1023.  
  1024. proc SAS::rebuildMenu {{menuName "sasMenu"} {pref ""}} {
  1025.     menu::buildSome $menuName
  1026. }
  1027.  
  1028. # Dim some menu items when there are no open windows.
  1029. set menuItems {
  1030.     processFile processSelection markSasFileAs
  1031.     insertPath 
  1032.     nextCommand prevCommand selectCommand
  1033. }
  1034. foreach i $menuItems {
  1035.     hook::register requireOpenWindowsHook [list sasMenu $i] 1
  1036. } 
  1037. unset i menuItems 
  1038.  
  1039. # Now we actually build the SAS menu.
  1040.  
  1041. menu::buildSome sasMenu
  1042.  
  1043.  
  1044. # ===========================================================================
  1045. # 
  1046. # ◊◊◊◊ SAS menu support ◊◊◊◊ #
  1047. # 
  1048.  
  1049. # This is the procedure called for all main menu items.
  1050.  
  1051. proc SAS::menuProc {menu item} {
  1052.     SAS::$item
  1053. }
  1054.  
  1055. # Give a beta message for untested features / menu items.
  1056.  
  1057. proc SAS::betaMessage {{kill 1}} {
  1058.     
  1059.     beep ; message "Sorry, this feature has not been fully implemented."
  1060.     if {$kill} {return -code return}
  1061. }
  1062.  
  1063. # ===========================================================================
  1064. # 
  1065. # Open the SAS home page.
  1066. # 
  1067.  
  1068. proc SAS::sasHomePage {} {
  1069.  
  1070.     global SASmodeVars
  1071.     
  1072.     url::execute $SASmodeVars(sasHomePage)
  1073. }
  1074.  
  1075. # ===========================================================================
  1076. # 
  1077. # Switch to SAS application
  1078. # 
  1079.  
  1080. proc SAS::switchToSas {} {app::launchFore [SAS::sig]}
  1081.  
  1082. # ===========================================================================
  1083. # 
  1084. # Return the SAS signature.
  1085. # 
  1086.  
  1087. proc SAS::sig {{app "SAS"}} {
  1088.     
  1089.     global SASmodeVars
  1090.     
  1091.     set lowApp [string tolower $app]
  1092.     set capApp [string toupper $app]
  1093.     if {$SASmodeVars(${lowApp}Sig) == ""} {
  1094.         alertnote "Looking for the $capApp application ..."
  1095.         SAS::setApplication $lowApp
  1096.     }
  1097.     return $SASmodeVars(${lowApp}Sig)
  1098. }
  1099.  
  1100. # ===========================================================================
  1101. # 
  1102. # Set Application
  1103. # 
  1104. # Prompt the user to locate the local SAS application.
  1105. # 
  1106.  
  1107. proc SAS::setApplication {{app "SAS"}} {
  1108.     
  1109.     global mode SASmodeVars
  1110.     
  1111.     set lowApp [string tolower $app]
  1112.     set capApp [string toupper $app]
  1113.     
  1114.     set newSig ""
  1115.     set newSig [dialog::askFindApp $capApp $SASmodeVars(${lowApp}Sig)]
  1116.     
  1117.     if {$newSig != ""} {
  1118.         set SASmodeVars(${lowApp}Sig) "$newSig"
  1119.         set oldMode $mode
  1120.         set mode "SAS"
  1121.         synchroniseModeVar "${lowApp}Sig" $SASmodeVars(${lowApp}Sig)
  1122.         set mode $oldMode
  1123.         message "The $capApp signature has been changed to \"$newSig\"."
  1124.     } else {
  1125.         message "Cancelled."
  1126.     }
  1127. }
  1128.  
  1129. # ===========================================================================
  1130. # 
  1131. # ◊◊◊◊ Help ◊◊◊◊ #
  1132. # 
  1133.  
  1134. proc SAS::helpProc {menu item} {
  1135.  
  1136.     global SASmodeVars SASPrefsInMenu
  1137.     
  1138.     if {$item == "wwwCommandHelp"} {
  1139.         SAS::wwwCommandHelp
  1140.     } elseif  {$item == "localCommandHelp"} {
  1141.         SAS::localCommandHelp
  1142.     } elseif {[lsearch -exact $SASPrefsInMenu $item] != -1} {
  1143.         SAS::flagFlip $item
  1144.         SAS::rebuildMenu sasHelp
  1145.     } elseif {$item == "setSasApplication"} {
  1146.         SAS::selectApplication "SAS"
  1147.     } elseif {$item == "sasModeHelp"} {
  1148.         package::helpFile "SAS"
  1149.     } else {
  1150.         SAS::$item
  1151.     } 
  1152. }
  1153.  
  1154. # ===========================================================================
  1155. # 
  1156. # ◊◊◊◊ Keywords ◊◊◊◊ #
  1157. # 
  1158.  
  1159. proc SAS::keywordsProc {menuName item} {
  1160.  
  1161.     global SASlowerCaseCmds
  1162.     
  1163.     if {$item == "listKeywords"} {
  1164.         set keywords [listpick -l -p "Current SAS mode keywords…" $SASlowerCaseCmds]
  1165.         foreach keyword $keywords {
  1166.             SAS::checkKeywords $keyword
  1167.         }
  1168.     } elseif {$item == "addNewCommands" || $item == "addNewArguments"} {
  1169.         set item [string trimleft $item "addNew"]
  1170.         if {$item == "Commands" && [llength [winNames]] && [askyesno \
  1171.           "Would you like to add all of the \"extra\" commands from this window\
  1172.           to the \"Add Commands\" preference?"] == "yes"} {
  1173.             SAS::addWindowCommands
  1174.         } else {
  1175.             SAS::addKeywords $item
  1176.         }
  1177.     } else {
  1178.         SAS::$item
  1179.     } 
  1180. }
  1181.  
  1182. # ===========================================================================
  1183. # 
  1184. # SAS::addWindowCommands
  1185. # 
  1186. # Add all of the "extra" commands which appear in entries in this window.
  1187. # 
  1188.  
  1189. proc SAS::addWindowCommands {} {
  1190.     
  1191.     global mode SAScmds SASmodeVars
  1192.     
  1193.     if {![llength [winNames]]} {
  1194.         message "Cancelled -- no current window!"
  1195.         return
  1196.     } 
  1197.     
  1198.     message "Scanning [win::CurrentTail] for all commands…"
  1199.     
  1200.     set pos [minPos]
  1201.     set pat {^([a-zA-Z0-9]+[a-zA-Z0-9])+[\t ]}
  1202.     while {![catch {search -f 1 -r 1 $pat $pos} match]} {
  1203.         set pos [nextLineStart [lindex $match 1]]
  1204.         set commandLine [getText [lindex $match 0] [lindex $match 1]]
  1205.         regexp $pat $commandLine match aCommand
  1206.         set aCommand [string tolower $aCommand]
  1207.         if {![lcontains SAScmds $aCommand]} {
  1208.             append SASmodeVars(addCommands) " $aCommand"
  1209.         } 
  1210.     }
  1211.     set SASmodeVars(addCommands) [lsort [lunique $SASmodeVars(addCommands)]]
  1212.     set oldMode $mode
  1213.     set mode "SAS"
  1214.     synchroniseModeVar addCommands $SASmodeVars(addCommands)
  1215.     set mode $oldMode
  1216.     if {[llength $SASmodeVars(addCommands)]} {
  1217.         SAS::colorizeSAS
  1218.         listpick -p "The \"Add Commands\" preference includes:" \
  1219.           $SASmodeVars(addCommands)
  1220.         message "Use the \"Mode Prefs --> Preferences\" menu item to edit keyword lists."
  1221.     } else {
  1222.         message "No \"extra\" commands from this window were found."
  1223.     } 
  1224. }
  1225.  
  1226. proc SAS::addKeywords {{category} {keywords ""}} {
  1227.     
  1228.     global mode SASmodeVars    
  1229.     
  1230.     if {$keywords == ""} {
  1231.         set keywords [prompt "Enter new SAS $category:" ""]
  1232.     }
  1233.     
  1234.     # The list of keywords should all be lower case.
  1235.     set keywords [string tolower $keywords]
  1236.     # Check to see if the keyword is already defined.
  1237.     foreach keyword $keywords {
  1238.         set checkStatus [Lisp::checkKeywords $keyword 1 0]
  1239.         if {$checkStatus != "0"} {
  1240.             alertnote "Sorry, \"$keyword\" is already defined\
  1241.               in the $checkStatus list."
  1242.             message "Cancelled."
  1243.             return -code return
  1244.         } 
  1245.     }
  1246.     # Keywords are all new, so add them to the appropriate mode preference.
  1247.     append SASmodeVars(add$category) " $keywords"
  1248.     set SASmodeVars(add$category) [lsort $SASmodeVars(add$category)]
  1249.     set oldMode $mode
  1250.     set mode "SAS"
  1251.     synchroniseModeVar add$category $SASmodeVars(add$category)
  1252.     set mode $oldMode
  1253.     SAS::colorizeSAS
  1254.     message "\"$keywords\" added to $category preference."
  1255. }
  1256.  
  1257. proc SAS::checkKeywords {{newKeywordList ""} {quietly 0} {noPrefs 0}} {
  1258.     
  1259.     global SASmodeVars
  1260.     
  1261.     global SASCommands  SASUserCommands  SASSubprocs     
  1262.     global SASArguments SASUserArguments SASOptions   SASParameters  
  1263.     
  1264.     set type 0
  1265.     if {$newKeywordList == ""} {
  1266.         set quietly 0
  1267.         set newKeywordList [prompt "Enter SAS mode keywords to be checked:" ""]
  1268.     }
  1269.     # Check to see if the new keyword(s) is already defined.
  1270.     foreach newKeyword $newKeywordList {
  1271.         if {[lsearch -exact $SASCommands $newKeyword] != "-1"} {
  1272.             set type SASCommands
  1273.         } elseif {[lsearch -exact $SASUserCommands $newKeyword] != "-1"} {
  1274.             set type SASUserCommands
  1275.         } elseif {[lsearch -exact $SASSubprocs $newKeyword] != "-1"} {
  1276.             set type SASSubprocs
  1277.         } elseif {[lsearch -exact $SASArguments $newKeyword] != "-1"} {
  1278.             set type SASArguments
  1279.         } elseif {[lsearch -exact $SASUserArguments $newKeyword] != "-1"} {
  1280.             set type SASUserArguments
  1281.         } elseif {[lsearch -exact $SASOptions $newKeyword] != "-1"} {
  1282.             set type SASOptions
  1283.         } elseif {[lsearch -exact $SASParameters $newKeyword] != "-1"} {
  1284.             set type SASParameters
  1285.         } elseif {!$noPrefs && \
  1286.           [lsearch -exact $SASmodeVars(addCommands) $newKeyword] != "-1"} {
  1287.             set type SASmodeVars(addCommands)
  1288.         } elseif {!$noPrefs && \
  1289.           [lsearch -exact $SASmodeVars(addArguments) $newKeyword] != "-1"} {
  1290.             set type SASmodeVars(addArguments)
  1291.         }
  1292.         if {$quietly} {
  1293.             # When this is called from other code, it should only contain
  1294.             # one keyword to be checked, and we'll return it's type.
  1295.             return "$type"
  1296.         } elseif {!$quietly && $type == 0} {
  1297.             alertnote "\"$newKeyword\" is not currently defined\
  1298.               as a SAS mode keyword"
  1299.         } elseif {$type != 0} {
  1300.             # This will work for any other value for "quietly", such as "2"
  1301.             alertnote "\"$newKeyword\" is currently defined as a keyword\
  1302.               in the \"$type\" list."
  1303.         } 
  1304.         set type 0
  1305.     }
  1306. }
  1307.  
  1308. # ===========================================================================
  1309. # 
  1310. # ◊◊◊◊ Marks ◊◊◊◊ #
  1311. # 
  1312.  
  1313. proc SAS::markFileProc {menu item} {
  1314.  
  1315.     if {$item == "source"} {
  1316.         SAS::MarkFile {.sas}
  1317.     } elseif {$item == "output"} {
  1318.         # doesn't really matter what we put for the mark file "type" here,
  1319.         # since output is the default if other "if ..." cases aren't met.
  1320.         SAS::MarkFile {.out}
  1321.     } elseif {$item == "autoMark"} {
  1322.         SAS::flagFlip autoMark
  1323.         SAS::rebuildMenu markSasFileAs…
  1324.     }
  1325. }
  1326.  
  1327. # ===========================================================================
  1328. # 
  1329. # ◊◊◊◊ Processing ◊◊◊◊ #
  1330. # 
  1331.  
  1332. # ===========================================================================
  1333. # 
  1334. # Process File
  1335. # 
  1336.  
  1337. # Send entire file to SAS for processing, adding carriage return at end
  1338. # of file if necessary.
  1339. # 
  1340. # Optional "f" argument allows this to be called by other code, or to be 
  1341. # sent via a Tcl shell window.
  1342. # 
  1343.  
  1344. proc SAS::processFile {{f ""} {app "SAS"}} {
  1345.     
  1346.     if {$f != ""} {file::openAny $f}
  1347.     set f [win::Current]
  1348.  
  1349.     set dirtyWindow [winDirty]
  1350.     set dontSave 0
  1351.     if {$dirtyWindow && [askyesno \
  1352.       "Do you want to save the file before sending it to SAS?"] == "yes"} {
  1353.         save
  1354.     } else {
  1355.         set dontSave 1
  1356.     } 
  1357.     if {!$dontSave && [lookAt [pos::math [maxPos] - 1]] != "\r"} {
  1358.         set pos [getPos]
  1359.         goto [maxPos]
  1360.         insertText "\r"
  1361.         goto $pos
  1362.         alertnote "Carriage return added to end of file."
  1363.         save
  1364.     }
  1365.  
  1366.     app::launchBack '[SAS::sig]'
  1367.     sendOpenEvent noReply '[SAS::sig]' $f
  1368.     switchTo '[SAS::sig]'
  1369. }
  1370.  
  1371. # ===========================================================================
  1372. # 
  1373. # Process Selection
  1374. # 
  1375. # Procedure to implement transfer of selected lines to SAS for processing.
  1376. # 
  1377.  
  1378. proc SAS::processSelection {{selection ""} {app "SAS"}} {
  1379.     
  1380.     global PREFS
  1381.     
  1382.     if {$selection == ""} {
  1383.         if {![isSelection]} {
  1384.             message "No selection -- cancelled."
  1385.             return
  1386.         } else {
  1387.             set selection [getSelect]
  1388.         } 
  1389.     }
  1390.     file::ensureDirExists [file join $PREFS SAS-tmp]
  1391.     set newFile [file join $PREFS SAS-tmp temp-SAS.do]
  1392.     file::writeAll $newFile $selection 1
  1393.  
  1394.     app::launchBack '[SAS::sig]'
  1395.     sendOpenEvent noReply '[SAS::sig]' $newFile
  1396.     switchTo '[SAS::sig]'
  1397. }
  1398.  
  1399. proc SAS::quitHook {} {temp::cleanup SAS-tmp}
  1400.  
  1401. # ===========================================================================
  1402. # 
  1403. # ◊◊◊◊ Insertions ◊◊◊◊ #
  1404. # 
  1405.  
  1406. proc SAS::insertPath {} {
  1407.     
  1408.     global file::separator
  1409.     
  1410.     set path ""
  1411.     set t    ""
  1412.     append t "\"${file::separator}"
  1413.     set path [getfile "Choose path of target file:"]
  1414.     if {$path != ""} {
  1415.         append t $path
  1416.         append t "\""
  1417.         insertText $t
  1418.     }
  1419. }
  1420.  
  1421. # ===========================================================================
  1422. # 
  1423. # ◊◊◊◊ Navigation ◊◊◊◊ #
  1424. # 
  1425.  
  1426. # Next/Prev command can simply return the position of the next command
  1427. # (quietly == 1), move the cursor to the next command (placing the cursor
  1428. # at the top of the window if toTop == 1), extend the current selection to
  1429. # the end of the this command, or (if the current command is already
  1430. # highlighted in its entirety) extend the current selection to the end of
  1431. # the next command.
  1432. # 
  1433.  
  1434. proc SAS::nextCommand {{quietly 0} {toTop 0}} {
  1435.     
  1436.     if {[pos::compare [selEnd] == [maxPos]]} {
  1437.         set pos [maxPos]
  1438.     } else {
  1439.         set pos [pos::math [selEnd] + 1]
  1440.     } 
  1441.     set pat {^[^\r\n\t \*/]}
  1442.  
  1443.     if {![catch {search -f 1 -r 1 $pat $pos} match]} {
  1444.         set pos [lineStart [lindex $match 1]]
  1445.     } else {
  1446.         set pos [maxPos]
  1447.     }
  1448.     if {$quietly} {
  1449.         return $pos
  1450.     } elseif {[isSelection]} {
  1451.     set limit1 [lindex [SAS::getCommand [selEnd]] 1]
  1452.     set limit2 [lindex [SAS::getCommand $pos    ] 1]
  1453.     if {$limit2 == "-1"} {set limit2 [maxPos]}
  1454.     if {$limit1 == "-1"} {set limit1 $limit2}
  1455.     if {[pos::compare [selEnd] < $limit1]} {
  1456.         select [getPos] $limit1
  1457.     } else {
  1458.         select [getPos] $limit2
  1459.     } 
  1460.     } elseif {$pos == [maxPos]} {
  1461.     message "No further commands in the file."
  1462.     return
  1463.     } else {
  1464.         goto $pos
  1465.         message [getText $pos [nextLineStart $pos]]
  1466.     } 
  1467.     if {$toTop} {insertToTop}
  1468. }
  1469.  
  1470. proc SAS::prevCommand {{quietly 0} {toTop 0}} {
  1471.     
  1472.     if {[pos::compare [getPos] == [minPos]]} {
  1473.         set pos [minPos]
  1474.     } else {
  1475.         set pos [pos::math [getPos] - 1]
  1476.     } 
  1477.     set pat {^[^\r\n\t \*/]}
  1478.  
  1479.     if {![catch {search -f 0 -r 1 $pat $pos} match]} {
  1480.         set pos [lineStart [lindex $match 1]]
  1481.     } else {
  1482.         set pos [minPos]
  1483.     }
  1484.     if {$quietly} {
  1485.         return $pos
  1486.     } elseif {[isSelection]} {
  1487.     # Going backwards is actually easier with selections.
  1488.     select $pos [selEnd]
  1489.     } elseif {$pos == [minPos]} {
  1490.         message "No further commands in the file."
  1491.         return
  1492.     } else {
  1493.         goto $pos
  1494.         message [getText $pos [nextLineStart $pos]]
  1495.     } 
  1496.     if {$toTop} {insertToTop}
  1497.     return $pos
  1498. }
  1499.  
  1500. proc SAS::searchFunc {direction} {
  1501.     
  1502.     if {$direction} {
  1503.         SAS::nextCommand
  1504.     } else {
  1505.         SAS::prevCommand
  1506.     }
  1507. }
  1508.  
  1509. proc SAS::selectCommand {} {
  1510.     
  1511.     set pos    [getPos]
  1512.     set limits [SAS::getCommand $pos]
  1513.     set posBeg [lindex $limits 0]
  1514.     set posEnd [lindex $limits 1]
  1515.     
  1516.     if {$posBeg != "-1" && $posEnd != "-1" && \
  1517.       [pos::compare $pos >= $posBeg] && [pos::compare $pos <= $posEnd]} {
  1518.         select $posBeg $posEnd
  1519.     } else {
  1520.         message "The cursor is not within a command."
  1521.         error "The cursor is not within a command."
  1522.     } 
  1523. }
  1524.  
  1525. proc SAS::copyCommand {{quietly 0}} {
  1526.     
  1527.     set pos [getPos]
  1528.     if {[set posBeg [lindex [SAS::getCommand $pos] 0]] != "-1"} {
  1529.         goto $posBeg
  1530.         forwardWord
  1531.         set posEnd [getPos]
  1532.         if {!$quietly} {
  1533.             select $posBeg $posEnd
  1534.             copy
  1535.             message "\"[getText $posBeg $posEnd]\" copied to clipboard."
  1536.         } 
  1537.         goto $pos
  1538.         return [getText $posBeg $posEnd]
  1539.     } elseif {!$quietly} {
  1540.         message "The cursor is not within a command."
  1541.     }
  1542.     return ""
  1543. }
  1544.  
  1545. proc SAS::reformatCommand {} {
  1546.     
  1547.     if {![isSelection]} {SAS::selectCommand} 
  1548.     message "Reformatting …"
  1549.     ::indentRegion
  1550.     goto [pos::math [getPos] -1]
  1551.     goto [SAS::nextCommand 1]
  1552.     message "Reformatted."
  1553. }
  1554.  
  1555. proc SAS::getCommand {pos} {
  1556.     
  1557.     set pos1 [pos::math [nextLineStart $pos] - 1]
  1558.     set pat {^[^\r\n\t \}\)]}
  1559.     set posBeg "-1"
  1560.     set posEnd "-1"
  1561.     if {![catch {search -f 0 -r 1 $pat $pos1} match]} {
  1562.         set posBeg [lindex $match 0]
  1563.         set pos2   [nextLineStart $posBeg]
  1564.         if {![catch {search -f 1 -r 1 $pat $pos2} match]} {
  1565.             set posEnd [lindex $match 0]
  1566.         } else {
  1567.             set posEnd [maxPos]
  1568.         } 
  1569.         # Now back up to remove empty or commented lines.
  1570.         set posEndPrev [pos::math $posEnd - 1]
  1571.         set prevLine [getText [lineStart $posEndPrev] $posEndPrev]
  1572.         while {[regexp {^[\t ]*$} $prevLine]} {
  1573.             set posEnd [lineStart $posEndPrev]
  1574.             set posEndPrev [pos::math $posEnd - 1]
  1575.             set prevLine [getText [lineStart $posEndPrev] $posEndPrev]
  1576.         }
  1577.     } 
  1578.     return [list $posBeg $posEnd]
  1579. }
  1580.  
  1581. # ===========================================================================
  1582. # 
  1583. # ◊◊◊◊ --------------------- ◊◊◊◊ #
  1584. # 
  1585. # ◊◊◊◊ version history ◊◊◊◊ #
  1586. # 
  1587. #  modified by  vers#  reason
  1588. #  -------- --- ------ -----------
  1589. #  01/28/20 cbu 1.0.1  First created sas mode, based upon other modes found 
  1590. #                        in Alpha's distribution.  Commands are based on 
  1591. #                        version 2.0.1 of SAS.
  1592. #  03/02/20 cbu 1.0.2  Minor modifications to comment handling.
  1593. #  03/20/00 cbu 1.0.3  Minor update of keywords dictionaries.
  1594. #                      Renamed mode SAS, from sas 
  1595. #  04/01/00 cbu 1.0.4  Fixed a little bug with "comment box".
  1596. #                      Added new preferences to allow the user to enter 
  1597. #                        additional commands and options.  
  1598. #                      Reduced the number of different user-specified colors.
  1599. #                      Added "Update Colors" proc to avoid need for a restart
  1600. #  04/08/00 cbu 1.0.5  Unset obsolete preferences from earlier versions.
  1601. #                      Modified "Electric Semi" added "Continue Comment" and
  1602. #                        "Electric Return Over-ride".
  1603. #                      Renamed "Update Colors" to "Update Preferences".
  1604. #  04/16/00 cbu 1.1    Renamed to sasMode.tcl
  1605. #                      Added "Mark File" and "Parse Functions" procs.
  1606. #  06/22/00 cbu 1.2    "Mark File" now recognizes headings as well as commands.
  1607. #                      "Mark File" recognizes source or output files.
  1608. #                      Completions, Completions Tutorial added.
  1609. #                      "Reload Completions", referenced by "Update Preferences".
  1610. #                      Better support for user defined keywords.
  1611. #                      Removed "Continue Comment", now global in Alpha 7.4.
  1612. #                      Added command double-click for on-line help.
  1613. #                      <shift, control>-<command> double-click syntax info.
  1614. #                        (Foundations, at least.  Ongoing project.)
  1615. #  06/22/00 cbu 1.2.1  "Mark File"ignores "run" commands.
  1616. #                      Minor keywords update.
  1617. #                      Beta-version of a SAS menu, based on the Stata menu.
  1618. #                      Added "sasSig" preference to allow user to find
  1619. #                        local application if necessary.
  1620. #                      Added SAS::sig which returns SAS signature.
  1621. #  08/28/00 cbu 1.2.2  Added some of the flag preferences to "SAS Help" menu.
  1622. #                      Added "flagFlip" to update preference bullets in menu.
  1623. #                      Added a "noHelpKey" preference, which switches the
  1624. #                        "help" key binding to F8.
  1625. #                      Added "Add New Commands / Arguments" to "SAS Help" menu.
  1626. #                      Added "Set SAS Application to "SAS Help" menu.
  1627. #  11/05/00 cbu 1.3    Added "next/prevCommand", "selectCommand", and
  1628. #                        "copyCommand" procs to menu.
  1629. #                      Added "SAS::indentLine".
  1630. #                      Added "SAS::reformatCommand" to menu.
  1631. #                      "SAS::reloadCompletions" is now obsolete.
  1632. #                      "SAS::updatePreferences" is now obsolete.
  1633. #                      "SAS::colorizeSAS" now takes care of setting all 
  1634. #                        keyword lists, including SAScmds.
  1635. #                      Cleaned up completion procs.  This file never has to be
  1636. #                        reloaded.  (Similar cleaning up for "SAS::DblClick").
  1637. #  11/16/00 cbu 2.0    New url prefs handling requires 7.4b21
  1638. #                      Added "Home Page" pref, menu item.
  1639. #                      Removed  hook::register requireOpenWindowsHook from
  1640. #                        mode declaration, put it after menu build.
  1641. #  12/19/00 cbu 2.1    The menu proc "Add Commands" now includes an option
  1642. #                        to grab all of the "extra" command from the current
  1643. #                        window, using SAS::addWindowCommands.
  1644. #                      Added "Keywords" submenu, "List Keywords" menu item.
  1645. #                      Big cleanup of ::sig, ::setApplication, processing ...
  1646. #  01/25/01 cbu 2.1.1  Bug fix for SAS::processSelection/File.
  1647. #                      Bug fix for comment characters.
  1648. #
  1649.  
  1650. # ===========================================================================
  1651. # 
  1652. # .
  1653.